home *** CD-ROM | disk | FTP | other *** search
- (*----------------------------------------------------------------------*)
- (* Get_Script_Command --- Get command from script buffer *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Get_Script_Command( VAR Command : PibTerm_Command_Type );
-
- (*----------------------------------------------------------------------*)
- (* *)
- (* Procedure: Get_Script_Command *)
- (* *)
- (* Purpose: Get command from script buffer *)
- (* *)
- (* Calling Sequence: *)
- (* *)
- (* Get_Script_Command( VAR Command : PibTerm_Command_Type ); *)
- (* *)
- (* Command --- command extracted from buffer *)
- (* *)
- (*----------------------------------------------------------------------*)
-
- VAR
- I : INTEGER;
- L : INTEGER;
- Ch : CHAR;
- IBogus : INTEGER;
- Key_Offset : INTEGER;
- Section_No : INTEGER;
- IVal : INTEGER;
- VPtrs : Script_Variable_List_Ptr;
-
- LABEL
- LDelaySy, LSuspendSy, LQuitSy, LChdirSy, LDosSy, LKeySy,
- LMessageSy, LRedialSy, LSTextSy, LTextSy, LTranslateSy,
- LWaitSy, LWriteLogSy, LDialSy, LExecuteSy, LExeNewSy,
- LFileSy, LRInputSy, LGoToXYSy, LPImportSy, LImportSy,
- LDeclareSy, LIfOKSy, LIfOpSy, LIfConSy, LIfDialSy,
- LIfFoundSy, LIfRemStrSy, LIfExistsSy, LIfLocStrSy, LKeySendSy,
- LKeyDefSy, LScriptSy, LSetSy, LCallSy, LGoToSy,
- LWaitStrSy, LCaptureSy, LWhenSy, LInputSy, LReceiveSy,
- LSendSy, LCloseSy, LOpenSy, LReadSy, LReadLnSy,
- LWriteSy, LWriteLnSy, LWhereXYSy, LWaitCountSy, LWaitQuietSy,
- LWaitTimeSy, LWaitListSy, LWhenDropSy, LZapVarSy, LMenuSy,
- LGetVarSy, LSetVarSy, LGetDirSy, LEndCase;
-
- (*----------------------------------------------------------------------*)
- (* Copy_Script_String --- Copy a string from the script buffer *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Copy_Script_String( VAR S: AnyStr; VAR V: INTEGER );
-
- (*----------------------------------------------------------------------*)
- (* *)
- (* Remarks: *)
- (* *)
- (* Each string is stored in the form: *)
- (* *)
- (* String_Type 1 byte *)
- (* String_Length 1 byte *)
- (* Text String_Length bytes *)
- (* *)
- (* The values for String_Type are: *)
- (* *)
- (* 0 --- ordinary string, text follows *)
- (* 1 --- use 'localreply' text *)
- (* 2 --- use 'remotereply' text *)
- (* 3 --- use 'set' variable -- String_length is index *)
- (* *)
- (* String_Length and Text are stored when String_Type = 0. *)
- (* Neither is stored for types 1 and 2. String_Length = *)
- (* variable index is stored for type 3. *)
- (* *)
- (*----------------------------------------------------------------------*)
-
- VAR
- L: INTEGER;
-
- BEGIN (* Copy_Script_String *)
- (* Pick up string type *)
-
- Script_Buffer_Pos := SUCC( Script_Buffer_Pos );
- V := Script_Buffer^[Script_Buffer_Pos];
-
- (* Get string value based upon type *)
- CASE V OF
-
- 0: BEGIN (* Text string *)
-
- Script_Buffer_Pos := SUCC( Script_Buffer_Pos );
-
- L := Script_Buffer^[Script_Buffer_Pos];
-
- MOVE( Script_Buffer^[Script_Buffer_Pos + 1], S[1], L );
-
- S[0] := CHR( L );
-
- Script_Buffer_Pos := Script_Buffer_Pos + L;
- {
- IF Debug_Mode THEN
- WRITELN('---> String length = ',L,', string = <',S,'>');
- }
- END;
-
- 1: BEGIN (* Local reply string *)
- S := Script_Reply;
- END;
-
- 2: BEGIN (* Remote reply string *)
- S := Script_Remote_Reply;
- END;
-
- 3: BEGIN (* Script variable *)
- Script_Buffer_Pos := SUCC( Script_Buffer_Pos );
- V := Script_Buffer^[Script_Buffer_Pos];
- S := Script_Variables^[V].Var_Value^;
- {
- IF Debug_Mode THEN
- WRITELN('---> Script variable ',V,' has value <',S,'>');
- }
- END (* Script variable *);
-
- ELSE
- S[0] := #0;
- V := 4;
- {
- IF Debug_Mode THEN
- WRITELN('---> BOGUS STRING MODE = ',V,' in Copy_Script_String.');
- }
- END (* CASE *);
-
- END (* Copy_Script_String *);
-
- (*----------------------------------------------------------------------*)
- (* Copy_Script_Integer --- Copy an integer from the script buffer *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Copy_Script_Integer( VAR IntVal: INTEGER;
- VAR V : INTEGER );
-
- (*----------------------------------------------------------------------*)
- (* *)
- (* Remarks: *)
- (* *)
- (* Each integer is stored in the form: *)
- (* *)
- (* Integer_Type 1 byte *)
- (* Integer_Value 2 bytes (if Integer_Type=0) *)
- (* *)
- (* The values for String_Type are: *)
- (* *)
- (* 0 --- integer constant (two bytes) follows *)
- (* n --- use variable "n" *)
- (* *)
- (*----------------------------------------------------------------------*)
-
- VAR
- Int_Bytes : ARRAY[1..2] OF BYTE ABSOLUTE IntVal;
-
- BEGIN (* Copy_Script_Integer *)
-
- Script_Buffer_Pos := SUCC( Script_Buffer_Pos );
- V := Script_Buffer^[Script_Buffer_Pos];
-
- IF ( V = 0 ) THEN
- BEGIN
- Int_Bytes[1] := Script_Buffer^[Script_Buffer_Pos + 1 ];
- Int_Bytes[2] := Script_Buffer^[Script_Buffer_Pos + 2 ];
- Script_Buffer_Pos := Script_Buffer_Pos + 2;
- END
- ELSE
- BEGIN
- Int_Bytes[1] := ORD( Script_Variables^[V].Var_Value^[1] );
- Int_Bytes[2] := ORD( Script_Variables^[V].Var_Value^[2] );
- END;
-
- END (* Copy_Script_Integer *);
-
- (*----------------------------------------------------------------------*)
- (* Copy_Script_Integer_Constant --- Copy integer cosntant from script *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Copy_Script_Integer_Constant( VAR IntVal: INTEGER );
-
- VAR
- Int_Bytes : ARRAY[1..2] OF BYTE ABSOLUTE IntVal;
-
- BEGIN (* Copy_Script_Integer_Constant *)
-
- Int_Bytes[1] := Script_Buffer^[Script_Buffer_Pos + 1 ];
- Int_Bytes[2] := Script_Buffer^[Script_Buffer_Pos + 2 ];
- Script_Buffer_Pos := Script_Buffer_Pos + 2;
-
- END (* Copy_Script_Integer_Constant *);
-
- (*----------------------------------------------------------------------*)
- (* Get_Transfer_Protocol --- Get file transfer protocol *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Get_Transfer_Protocol;
-
- VAR
- I : INTEGER;
- Found : BOOLEAN;
- TName : Char_2;
- TType : Transfer_Type;
-
- BEGIN (* Get_Transfer_Protocol *)
-
- Found := FALSE;
- (* Pick up transfer type name *)
- TName := ' ';
- TType := None;
-
- FOR I := 1 TO MIN( 2 , LENGTH( Script_String_2 ) ) DO
- TName[I] := UpCase( Script_String_2[I] );
-
- (* Look up transfer name *)
-
- FOR I := 1 TO ( Max_Transfer_Types - 1 ) DO
- IF ( TName = Trans_Type_Name[Transfers[I]] ) THEN
- BEGIN
- TType := Transfers[I];
- Found := TRUE;
- END;
- (* Didn't find it -- check special *)
- (* Kermit names. *)
- IF ( NOT Found ) THEN
- IF ( TName = 'K ' ) THEN
- TType := Kermit
- ELSE IF ( TName = 'KA' ) THEN
- BEGIN
- TType := Kermit;
- Kermit_File_Type_Var := Kermit_Ascii;
- END
- ELSE IF ( TName = 'KB' ) THEN
- BEGIN
- TType := Kermit;
- Kermit_File_Type_Var := Kermit_Binary;
- END;
- (* Assume default type if none given *)
- IF ( TType = None ) THEN
- TType := Default_Transfer_Type;
-
- (* Record transfer type *)
-
- Script_Integer_1 := ORD( TType ) + 1;
-
- END (* Get_Transfer_Protocol *);
-
- (*----------------------------------------------------------------------*)
- (* Fix_Wait_Time --- Fix up time to wait for WAIT* commands *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Fix_Wait_Time;
-
- BEGIN (* Fix_Wait_Time *)
-
- IF ( Script_Wait_Time <= 0 ) THEN
- Script_Wait_Time := Script_Default_Wait_Time;
-
- IF ( Script_Wait_Time <= 0 ) THEN
- Script_Wait_Time := 30;
-
- Really_Wait_String := TRUE;
-
- Script_Wait_Start := TimeOfDay;
- Script_Wait_Found := FALSE;
-
- Command := Null_Command;
-
- END (* Fix_Wait_Time *);
-
- (*----------------------------------------------------------------------*)
- (* Get_WaitList --- Get stuff for WaitList command execution *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Get_WaitList;
-
- BEGIN (* Get_WaitList *)
- (* Get result variable index *)
-
- Copy_Script_Integer( IBogus , Script_Wait_Result_Index );
-
- (* Zero out result index *)
-
- Script_Variables^[Script_Wait_Result_Index].Var_Value^ := CHR( 0 ) + CHR( 0 );
-
- (* Get # of strings *)
-
- Script_Buffer_Pos := SUCC( Script_Buffer_Pos );
- Script_Wait_Count := Script_Buffer^[Script_Buffer_Pos];
- Script_Wait_Check_Length := 0;
-
- (* Set up vector of wait strings *)
-
- FOR I := 1 TO Script_Wait_Count DO
- WITH Script_Wait_List[I] DO
- BEGIN
- NEW( Wait_Text );
- Copy_Script_String( Wait_Text^ , IBogus );
- Wait_Text^ := Read_Ctrls( Wait_Text^ );
- NEW( Wait_Reply );
- Wait_Reply^[0] := #0;
- Script_Wait_Check_Length := MAX( Script_Wait_Check_Length ,
- LENGTH( Wait_Text^ ) );
- END;
-
- Copy_Script_Integer_Constant( Script_Wait_Failure );
-
- WaitString_Mode := ( ( Script_Wait_Count > 0 ) AND
- ( Script_Wait_Check_Length > 0 ) );
-
- (* Get wait time *)
-
- Script_Wait_Time := Script_Default_Wait_Time;
-
- Fix_Wait_Time;
-
- END (* Get_WaitList *);
-
- (*----------------------------------------------------------------------*)
- (* Get_WaitString --- Get stuff for WaitString command execution *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Get_WaitString;
-
- BEGIN (* Get_WaitString *)
-
- Copy_Script_String ( Script_String , IBogus );
- Copy_Script_String ( Script_String_2 , IBogus );
- Copy_Script_Integer( Script_Wait_Time , IBogus );
-
- (* No result index *)
- Script_Wait_Result_Index := 0;
-
- (* If waitstring null, skip this guy *)
-
- IF ( LENGTH( Script_String ) = 0 ) THEN
- BEGIN
- WaitString_Mode := FALSE;
- Script_Wait_Count := 0;
- END
- ELSE
- BEGIN
- (* One waitstring *)
- Script_Wait_Count := 1;
- WaitString_Mode := TRUE;
-
- WITH Script_Wait_List[1] DO
- BEGIN
- NEW( Wait_Text );
- Wait_Text^ := Read_Ctrls( Script_String );
- NEW( Wait_Reply );
- Wait_Reply^ := Read_Ctrls( Script_String_2 );
- Script_Wait_Check_Length := LENGTH( Script_String );
- END;
-
- (* Fix up wait time *)
- Fix_Wait_Time;
-
- END;
-
- Copy_Script_Integer_Constant( Script_Wait_Failure );
-
- END (* Get_WaitString *);
-
- (*----------------------------------------------------------------------*)
- (* Get_Menu --- Get stuff for MENU command *)
- (*----------------------------------------------------------------------*)
-
- PROCEDURE Get_Menu;
-
- VAR
- Default : INTEGER;
- Row : INTEGER;
- Col : INTEGER;
- NItems : INTEGER;
- Items : INTEGER;
-
- BEGIN (* Get_Menu *)
- (* Result variable index *)
-
- Copy_Script_Integer( IBogus , Script_Integer_1 );
-
- (* Display position *)
-
- Copy_Script_Integer( Col , IBogus );
- Copy_Script_Integer( Row , IBogus );
-
- (* Default *)
-
- Copy_Script_Integer( Default , IBogus );
-
- (* Get menu title *)
-
- Copy_Script_String( Script_String , IBogus );
-
- (* Get # of items *)
-
- Script_Buffer_Pos := SUCC( Script_Buffer_Pos );
- NItems := Script_Buffer^[Script_Buffer_Pos];
-
- (* Generate the menu *)
-
- NEW( Script_Menu_Holder );
-
- Make_A_Menu( Script_Menu_Holder^, NItems, Row, Col, 0, 0, Default,
- Script_String, '', FALSE );
-
- (* Get and store item strings *)
- FOR Items := 1 TO NItems DO
- Copy_Script_String( Script_Menu_Holder^.Menu_Entries[Items].Menu_Item_Text ,
- IBogus );
-
- END (* Get_Menu *);
-
- (*----------------------------------------------------------------------*)
- (* Locate_Var --- Locate variable *)
- (*----------------------------------------------------------------------*)
-
- FUNCTION Locate_Var( VPtrs : Script_Variable_List_Ptr;
- VCount : INTEGER;
- VName : AnyStr;
- VAR VType : ShortStr;
- VAR Value : AnyStr ) : INTEGER;
-
- VAR
- I : INTEGER;
- IVal : INTEGER;
-
- BEGIN (* Locate_Var *)
-
- VType := 'UNDEFINED';
- Value[0] := #0;
- Locate_Var := 0;
- VName := UpperCase( VName );
-
- FOR I := VCount DOWNTO 2 DO
- IF ( VName = VPtrs^[I].Var_Name ) THEN
- BEGIN
- CASE VPtrs^[I].Var_Type OF
- Integer_Variable_Type : BEGIN
- VType := 'INTEGER';
- MOVE( VPtrs^[I].Var_Value^[1], IVal, 2 );
- STR( IVal , Value );
- END;
- String_Variable_Type : BEGIN
- VType := 'STRING';
- Value := VPtrs^[I].Var_Value^;
- END;
- END (* CASE *);
- Locate_Var := I;
- EXIT;
- END;
-
- END (* Locate_Var *);
-
- (*----------------------------------------------------------------------*)
-
- BEGIN (* Get_Script_Command *)
- (* Check for suspended script *)
- (* and exit if suspension still *)
- (* in progress. *)
-
- IF ( Script_Suspend_Time > 0.0 ) THEN
- IF ( TimeDiffH( Script_Suspend_Start, TimeOfDayH ) >
- Script_Suspend_Time ) THEN
- BEGIN
- Command := Null_Command;
- EXIT;
- END
- ELSE
- Script_Suspend_Time := 0.0;
-
- (* Set script strings to null *)
- Script_String [0] := #0;
- Script_String_2 [0] := #0;
- Script_Integer_1 := 0;
- (* Point to next command in buffer *)
-
- Script_Buffer_Pos := SUCC( Script_Buffer_Pos );
-
- (* Pick up command type *)
-
- Command := PibTerm_Command_Table_2[ Script_Buffer^[Script_Buffer_Pos] ];
-
- (* For commands with arguments, *)
- (* get the arguments. *)
- {
- CASE Command Of
- }
- (* Use jump table to avoid time-consuming *)
- (* CASE statement. *)
- I := ORD( Command );
-
- INLINE(
- $8B/$9E/>I { MOV BX,[BP+>I] ;Pick up ORD(Command)}
- /$89/$D8 { MOV AX,BX ;Command}
- /$D1/$E3 { SHL BX,1 ;Command * 2}
- /$01/$C3 { ADD BX,AX ;Command * 3}
- /$B8/>*+6 { MOV AX,>*+6 ;Address of first GOTO}
- /$01/$C3 { ADD BX,AX ;Add offset of command}
- /$FF/$E3 { JMP BX ;Branch to proper GOTO}
- );
- GOTO LEndCase;
- GOTO LEndCase;
- GOTO LEndCase;
- GOTO LEndCase;
- GOTO LEndCase;
- GOTO LCallSy;
- GOTO LCaptureSy;
- GOTO LEndCase;
- GOTO LChDirSy;
- GOTO LEndCase;
- GOTO LCloseSy;
- GOTO LEndCase;
- GOTO LEndCase;
- GOTO LDeclareSy;
- GOTO LDelaySy;
- GOTO LEndCase;
- GOTO LDialSy;
- GOTO LEndCase;
- GOTO LDosSy;
- GOTO LEndCase;
- GOTO LEndCase;
- GOTO LEndCase;
- GOTO LEndCase;
- GOTO LEndCase;
- GOTO LEndCase;
- GOTO LEndCase;
- GOTO LEndCase;
- GOTO LEndCase;
- GOTO LEndCase;
- GOTO LExecuteSy;
- GOTO LExeNewSy;
- GOTO LEndCase;
- GOTO LEndCase;
- GOTO LEndCase;
- GOTO LFileSy;
- GOTO LEndCase;
- GOTO LGetDirSy;
- GOTO LEndCase;
- GOTO LGetVarSy;
- GOTO LEndCase;
- GOTO LGoToSy;
- GOTO LGoToXYSy;
- GOTO LEndCase;
- GOTO LEndCase;
- GOTO LIfConSy;
- GOTO LIfDialSy;
- GOTO LEndCase;
- GOTO LIfExistsSy;
- GOTO LIfFoundSy;
- GOTO LIfLocStrSy;
- GOTO LIfOkSy;
- GOTO LIfOpSy;
- GOTO LIfRemStrSy;
- GOTO LImportSy;
- GOTO LEndCase;
- GOTO LInputSy;
- GOTO LEndCase;
- GOTO LKeyDefSy;
- GOTO LEndCase;
- GOTO LKeySendSy;
- GOTO LKeySy;
- GOTO LEndCase;
- GOTO LEndCase;
- GOTO LMenuSy;
- GOTO LMessageSy;
- GOTO LEndCase;
- GOTO LOpenSy;
- GOTO LEndCase;
- GOTO LPImportSy;
- GOTO LEndCase;
- GOTO LQuitSy;
- GOTO LReadSy;
- GOTO LReadLnSy;
- GOTO LReceiveSy;
- GOTO LReDialSy;
- GOTO LEndCase;
- GOTO LEndCase;
- GOTO LEndCase;
- GOTO LRInputSy;
- GOTO LScriptSy;
- GOTO LEndCase;
- GOTO LSendSy;
- GOTO LSetSy;
- GOTO LEndCase;
- GOTO LSetVarSy;
- GOTO LSTextSy;
- GOTO LSuspendSy;
- GOTO LTextSy;
- GOTO LEndCase;
- GOTO LTranslateSy;
- GOTO LEndCase;
- GOTO LEndCase;
- GOTO LWaitSy;
- GOTO LWaitCountSy;
- GOTO LWaitListSy;
- GOTO LWaitQuietSy;
- GOTO LWaitStrSy;
- GOTO LWaitTimeSy;
- GOTO LWhenSy;
- GOTO LWhenDropSy;
- GOTO LEndCase;
- GOTO LWhereXYSy;
- GOTO LEndCase;
- GOTO LWriteSy;
- GOTO LWriteLnSy;
- GOTO LWriteLogSy;
- GOTO LZapVarSy;
- GOTO LEndCase;
- GOTO LEndCase;
-
- LDelaySy : BEGIN
- Copy_Script_Integer( Script_Integer_1 , IBogus );
- Delay_Time := Script_Integer_1 * 100;
- END;
- GOTO LEndCase;
-
- LSuspendSy : BEGIN
- Copy_Script_Integer( Script_Integer_1 , IBogus );
- Script_Suspend_Time := Script_Integer_1;
- Script_Suspend_Time := Script_Suspend_Time * 10.0;
- Script_Suspend_Start := TimeOfDayH;
- Command := Null_Command;
- END;
- GOTO LEndCase;
-
- LQuitSy : Copy_Script_Integer_Constant( Script_Integer_1 );
- GOTO LEndCase;
-
- LChdirSy : BEGIN
- Copy_Script_String( Script_String , IBogus );
- IVal := POS( ':' , Script_String );
- IF ( IVal > 0 ) THEN
- BEGIN
- Script_String_2 := Script_String[1];
- Script_String := Substr( Script_String,
- SUCC( IVal ),
- 255 );
- END
- ELSE
- Script_String_2 := Dir_Get_Default_Drive;
- END;
- GOTO LEndCase;
-
- LDosSy :
- LKeySy :
- LMessageSy :
- LRedialSy :
- LSTextSy :
- LTextSy :
- LTranslateSy:
- LWaitSy :
- LWriteLogSy : Copy_Script_String( Script_String , IBogus );
- GOTO LEndCase;
-
- LDialSy : BEGIN
- Copy_Script_String ( Script_String , IBogus );
- Copy_Script_Integer_Constant( Script_Integer_1 );
- END;
- GOTO LEndCase;
-
- LExecuteSy : BEGIN
- Copy_Script_String( Script_String_2 , IBogus );
- Script_Buffer_Pos := SUCC( Script_Buffer_Pos );
- Script_Parameter_Count := Script_Buffer^[Script_Buffer_Pos];
- IF( Script_Parameter_Count > 0 ) THEN
- BEGIN
- NEW( Script_Parameters );
- FOR I := 1 TO Script_Parameter_Count DO
- BEGIN
- Script_Buffer_Pos := SUCC( Script_Buffer_Pos );
- Script_Parameters^[I] :=
- Script_Buffer^[Script_Buffer_Pos];
- END;
- END
- ELSE
- Script_Parameters := NIL;
- Script_String := 'E';
- END;
- GOTO LEndCase;
-
- LExeNewSy : BEGIN
- Copy_Script_String( Script_String_2 , IBogus );
- Copy_Script_String( Script_String , IBogus );
- Script_String := Script_String + CHR( CR );
- MOVE( Script_String[0], Mem[CSeg:$80],
- ORD( Script_String[0] ) );
- Script_String := 'E';
- END;
- GOTO LEndCase;
-
- LFileSy : BEGIN
- Copy_Script_Integer( Script_Integer_1 , IBogus );
- Copy_Script_String ( Script_String , IBogus );
- Copy_Script_String ( Script_String_2 , IBogus );
- END;
- GOTO LEndCase;
-
- LRInputSy : BEGIN
- Copy_Script_String ( Script_String , IBogus );
- Copy_Script_Integer_Constant( Script_Integer_1 );
- Copy_Script_String ( Script_String_2 ,
- Script_Integer_2 );
- END;
- GOTO LEndCase;
-
- LGoToXYSy : BEGIN
- Copy_Script_Integer( Script_Integer_1 , IBogus );
- Copy_Script_Integer( Script_Integer_2 , IBogus );
- END;
- GOTO LEndCase;
-
- LPImportSy :
- LImportSy :
- LDeclareSy : BEGIN
- Copy_Script_String ( Script_String , IBogus );
- Copy_Script_Integer_Constant( Script_Integer_1 );
- Copy_Script_Integer_Constant( Script_Integer_2 );
- Copy_Script_String ( Script_String_2 , IBogus );
- END;
- GOTO LEndCase;
-
- LIfOKSy :
- LIfOpSy :
- LIfConSy :
- LIfDialSy :
- LIfFoundSy : BEGIN
- Copy_Script_Integer_Constant( Script_Integer_1 );
- Copy_Script_Integer_Constant( Script_Integer_2 );
- Copy_Script_Integer_Constant( Script_Integer_3 );
- END;
- GOTO LEndCase;
-
- LIfRemStrSy :
- LIfExistsSy :
- LIfLocStrSy : BEGIN
- Copy_Script_Integer_Constant( Script_Integer_1 );
- Copy_Script_Integer_Constant( Script_Integer_2 );
- Copy_Script_Integer_Constant( Script_Integer_3 );
- Copy_Script_String ( Script_String , IBogus );
- END;
- GOTO LEndCase;
-
- LKeySendSy : BEGIN
- Copy_Script_String( Script_String , IBogus );
- Get_Key_Section( Script_String, Key_Offset, Key_No, Section_No );
- END;
- GOTO LEndCase;
-
- LKeyDefSy : BEGIN
- Copy_Script_String( Script_String , IBogus );
- Copy_Script_String( Script_String_2 , IBogus );
- END;
- GOTO LEndCase;
-
- LScriptSy : BEGIN
- Script_Buffer_Pos := SUCC( Script_Buffer_Pos );
- Script_String := CHR( Script_Buffer^[Script_Buffer_Pos] );
- Copy_Script_String( Script_String_2 , IBogus );
- END;
- GOTO LEndCase;
-
- LSetSy : BEGIN
- Copy_Script_Integer_Constant( Script_Integer_1 );
- END;
- GOTO LEndCase;
-
- LCallSy : BEGIN
-
- Script_Call_Depth := SUCC( Script_Call_Depth );
-
- WITH Script_Call_Stack[Script_Call_Depth] DO
- BEGIN
- Proc_Param := Proc_Parameters;
- Proc_Got := Proc_Parameter_Got;
- Proc_Count := Proc_Parameter_Count;
- Save_Vars := NIL;
- END;
-
- Copy_Script_Integer_Constant( Script_Integer_1 );
-
- Script_Buffer_Pos := SUCC( Script_Buffer_Pos );
-
- Proc_Parameter_Count := Script_Buffer^[Script_Buffer_Pos];
-
- IF( Proc_Parameter_Count > 0 ) THEN
- BEGIN
- NEW( Proc_Parameters );
- FOR I := 1 TO Proc_Parameter_Count DO
- BEGIN
- Script_Buffer_Pos := SUCC( Script_Buffer_Pos );
- Proc_Parameters^[I] :=
- Script_Buffer^[Script_Buffer_Pos];
- END;
- END
- ELSE
- Proc_Parameters := NIL;
-
- Script_Call_Stack[Script_Call_Depth].Return_Addr :=
- Script_Buffer_Pos;
-
- Proc_Parameter_Got := 0;
- Proc_Parameter_Count := 0;
-
- Script_Buffer_Pos := PRED( Script_Integer_1 );
- Command := Null_Command;
-
- END;
- GOTO LEndCase;
-
- LGoToSy : Copy_Script_Integer_Constant( Script_Integer_1 );
- GOTO LEndCase;
-
- LWaitStrSy : Get_WaitString;
- GOTO LEndCase;
-
- LCaptureSy : BEGIN
- Copy_Script_String( Script_String , IBogus );
- Copy_Script_String( Script_String_2 , IBogus );
- END;
- GOTO LEndCase;
-
- LWhenSy : BEGIN
- Copy_Script_String( Script_When_Text , IBogus );
- Copy_Script_String( Script_When_Reply_Text , IBogus );
- When_Mode := ( LENGTH( Script_When_Text ) > 0 );
- Command := Null_Command;
- END;
- GOTO LEndCase;
-
- LInputSy : BEGIN
- Copy_Script_String( Script_String , IBogus );
- Copy_Script_String( Script_String_2 , Script_Integer_1 );
- END;
- GOTO LEndCase;
-
- LReceiveSy :
- LSendSy : BEGIN
- Copy_Script_String( Script_String , IBogus );
- Copy_Script_String( Script_String_2 , IBogus );
- Get_Transfer_Protocol;
- END;
- GOTO LEndCase;
-
- LCloseSy : Copy_Script_Integer( Script_Integer_1 , IBogus );
- GOTO LEndCase;
-
- LOpenSy : BEGIN
- Copy_Script_Integer( Script_Integer_1 , IBogus );
- Copy_Script_String ( Script_String , IBogus );
- Copy_Script_Integer( Script_Integer_2 , IBogus );
- END;
- GOTO LEndCase;
-
- LReadSy : BEGIN
- Copy_Script_Integer( Script_Integer_1 , IBogus );
- Copy_Script_String ( Script_String , Script_Integer_2 );
- Copy_Script_Integer( Script_Integer_3 , IBogus );
- END;
- GOTO LEndCase;
-
- LReadLnSy :
- LWriteSy :
- LWriteLnSy : BEGIN
- Copy_Script_Integer( Script_Integer_1 , IBogus );
- Copy_Script_String ( Script_String , Script_Integer_2 );
- END;
- GOTO LEndCase;
-
- LWhereXYSy : BEGIN
- Copy_Script_Integer( IBogus , Script_Integer_1 );
- Copy_Script_Integer( IBogus , Script_Integer_2 );
- END;
- GOTO LEndCase;
-
- LWaitCountSy: BEGIN
- Copy_Script_Integer( Script_Wait_Check_Length , IBogus );
- Script_Wait_Char_Count := 0;
- Script_Wait_Time := Script_Default_Wait_Time;
- Fix_Wait_Time;
- END;
- GOTO LEndCase;
-
- LWaitQuietSy: BEGIN
- Copy_Script_Integer( Script_Integer_1 , IBogus );
- IF ( Script_Integer_1 > 0 ) THEN
- BEGIN
- Script_WaitQuiet_Time := Script_Integer_1;
- Script_WaitQuiet_Time := Script_WaitQuiet_Time * 10.0;
- Script_Wait_Start := TimeOfDayH;
- Really_Wait_String := TRUE;
- WaitQuiet_Mode := TRUE;
- END;
- Command := Null_Command;
- END;
- GOTO LEndCase;
-
- LWaitTimeSy : BEGIN
- Copy_Script_Integer( Script_Integer_1 , IBogus );
- Script_Default_Wait_Time := Script_Integer_1;
- Command := Null_Command;
- END;
- GOTO LEndCase;
-
- LWaitListSy : Get_WaitList;
- GOTO LEndCase;
-
- LWhenDropSy : BEGIN
- Copy_Script_String( Script_When_Drop_Text , IBogus );
- When_Drop_Mode := ( LENGTH( Script_When_Drop_Text ) > 0 );
- Command := Null_Command;
- END;
- GOTO LEndCase;
-
- LZapVarSy : BEGIN
- Copy_Script_Integer( Script_Integer_1 , IBogus );
- Copy_Script_Integer( Script_Integer_2 , IBogus );
- END;
- GOTO LEndCase;
-
- LMenuSy : Get_Menu;
- GOTO LEndCase;
-
- LGetVarSy : BEGIN
- Copy_Script_String ( Script_String , Script_Integer_1 );
- Copy_Script_String ( Script_String_2 , Script_Integer_2 );
- Copy_Script_String ( Script_String_3 , Script_Integer_3 );
- I := Locate_Var( Script_Variables,
- Script_Variable_Count,
- Script_String,
- Script_Variables^[Script_Integer_2].Var_Value^,
- Script_Variables^[Script_Integer_3].Var_Value^ );
- IF ( ( I = 0 ) AND ( Script_Stack_Depth > 0 ) ) THEN
- I := Locate_Var( Prev_Script_Variables,
- Script_Stack_Position[Script_Stack_Depth].Vars_Count,
- Script_String,
- Script_Variables^[Script_Integer_2].Var_Value^,
- Script_Variables^[Script_Integer_3].Var_Value^ );
- Command := Null_Command;
- END;
- GOTO LEndCase;
-
- LSetVarSy : BEGIN
- Copy_Script_String ( Script_String , Script_Integer_1 );
- Copy_Script_String ( Script_String_4 , Script_Integer_4 );
- VPtrs := Script_Variables;
- I := Locate_Var( Script_Variables,
- Script_Variable_Count,
- Script_String,
- Script_String_2,
- Script_String_3 );
- IF ( ( I = 0 ) AND ( Script_Stack_Depth > 0 ) ) THEN
- BEGIN
- VPtrs := Prev_Script_Variables;
- I := Locate_Var( Prev_Script_Variables,
- Script_Stack_Position[Script_Stack_Depth].Vars_Count,
- Script_String,
- Script_String_2,
- Script_String_3 );
- END;
- IF ( I > 0 ) THEN
- BEGIN
- IF ( Script_String_2 = 'INTEGER' ) THEN
- BEGIN
- Script_String_4 := LTrim( Trim( Script_String_4 ) );
- VAL( Script_String_4, IVal, L );
- IF ( L = 0 ) THEN
- BEGIN
- Script_String_4[0] := CHR( 2 );
- MOVE( IVal, Script_String_4[1], 2 );
- END
- ELSE
- Script_String_4 := #0 + #0;
- END;
- VPtrs^[I].Var_Value^ := Script_String_4;
- END;
- Command := Null_Command;
- END;
- GOTO LEndCase;
-
- LGetDirSy: BEGIN
- Copy_Script_String ( Script_String , Script_Integer_1 );
- Copy_Script_String ( Script_String_2 , Script_Integer_2 );
- END;
- GOTO LEndCase;
-
- LEndCase : ;
- {
- END (* CASE *);
- }
-
- END (* Get_Script_Command *);